home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xm / main-window < prev    next >
Encoding:
Text File  |  1991-09-26  |  1.6 KB  |  47 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Main window demo
  4.  
  5. (require 'motif)
  6. (load-widgets drawing-area shell main-window scroll-bar row-column
  7.           cascade-button command)
  8.  
  9. (define top (application-initialize 'main-window))
  10. (set-values! top 'width 500 'height 800)
  11.  
  12. (define mw (create-managed-widget (find-class 'main-window) top))
  13. (set-values! mw 'show-separator #t)
  14.  
  15. (define sb (create-managed-widget (find-class 'scroll-bar) mw))
  16. (define sb2 (create-managed-widget (find-class 'scroll-bar) mw
  17.    'orientation "horizontal"))
  18. (define dr (create-managed-widget (find-class 'drawing-area) mw))
  19.  
  20. (set-values! mw 'vertical-scroll-bar sb 'horizontal-scroll-bar sb2)
  21. (set-values! mw 'work-window dr)
  22.  
  23. (define mb (create-managed-widget (find-class 'row-column) mw
  24.    'row-column-type 'menu-bar))
  25.  
  26. (define b1 (create-managed-widget (find-class 'cascade-button) mb))
  27. (set-values! b1 'label-string 'File)
  28. (define b2 (create-managed-widget (find-class 'cascade-button) mb))
  29. (set-values! b2 'label-string 'Edit)
  30. (define b2 (create-managed-widget (find-class 'cascade-button) mb))
  31. (set-values! b2 'label-string 'Properties)
  32. (define b4 (create-managed-widget (find-class 'cascade-button) mb))
  33. (set-values! b4 'label-string 'Help)
  34.  
  35. (set-values! mb 'menu-help-widget b4)
  36.  
  37. (set-values! mw 'menu-bar mb)
  38.  
  39. (define cmd (create-managed-widget (find-class 'command) mw))
  40. (set-values! cmd 'prompt-string "What next:" 'history-visible-item-count 5)
  41. (set-values! cmd 'history-item-count 7 'history-items
  42.   '(ls\ -l\ /bin write\ fred pwd mail\ dmr man\ 8\ crash shutdown\ +k
  43.   echo\ "hello"))
  44.  
  45. (realize-widget top)
  46. (context-main-loop (widget-context top))
  47.